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AUTHOR BRIAN PORTER CREATION DATE 07=-MAR-79 


Functional description: 
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This routine outputs the bit-to-text translation for a given 


register bit field. The bit-to-text translation is controlled by 

0038 ergunent FLAG, If FLAG is ‘O° then all set bits are translated, 
0039 If FLAG is "1° then all clear bits are translated. If FLAG is ‘2° 
sine then all bits are translated according to their a Rc 
94 4 Modified by: 
0044 v03-001 BP0001 Brian Porter, 20-AUG-1982 
0045 Added some definitions. 
0046 ee 
0047 = 

8 
0049 


subroutine output (lun,register_mask,text_array,text_array_base, 
1 translation_start_bit,translation_end_bit,translatton_control. flag) 
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byte lun 
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8 02 
$3 byte translation_control_flag 3 
1 integers4 text_array_base 3 
Bos integers4 translation_start_bit 03 
O06 integer*4 translation_end_bit 85 
006 integer*4 register_mask 021 
0068 . ee 031 
i integer*4 polarity 8 | 
0071 integer*4 LibSextzv 02! 
007 " 021 
th integer*4 compressc 8s! 
tg character*(*) text_array(text_array_base:translation_end_bit,0:1) 8s. 
007 02' 
02! 
0079 5 
ies do 100,i = translation_start_bit,translation_end_bit | 
at) polarity = LibSextzv (i,1,register_mask) 
0084 if ((translation_control_flag .eq. ‘0° 
0085 1 end. 0 atid. 
0086 1 polarity .eq. 1) 
0087 .or 


: 


1 ° 
1 (translation_control_flag .eq. ‘1' 
' and 


0090 polarit 0)) th 
olar eq. 
0091 “ —_ an 
94 call Linchk (lun,1) 
009 
0094 write(lun,10) text_array(i,0) 
0095 10 format(* °,t40,a<compressc (text_array(i,0))>) 
0097 else if (translation_control_flag .eq. '2°) then 


call Linchk (lun,1) 


8 

100 

101 write(lun,20) text_array(i,polarity) 

44 20 format(' *,t40,a<compressc (text_array(i,polarity))>) 
010 endif 

104 

105 100 continue 

88 

10 return 
gine 

109 end 
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] 
PROGRAM SECTIONS | 
Name Bytes Attributes | 


1*4 COMPRESSC I*4 LIBSEXTZV LINCHK 


0 SCODE 375 PIC CON REL LCL SHR EXE RD NOWRT LONG 
1 SPDATA + PIC CON REL LCL SHR NOEXE RD NOWRT LONG 
2 SLOCAL 1 PIC CON REL LCL NOSHR NOEXE RD WRT LONG 
Total Space Allocated 511 
ENTRY POINTS EN’ 
Address Type Name 
0-00000000 OUTPUT 
VARIABLES VAI 
Address Type Name Address Type Name 
-00000006 I*4 | pra 44 944 ed L*1 LUN 
abopooneete 1*4 POLARITY P~pbooeOT TS I*4 REGISTER_MASK 
AP-00000010@ I*4 TEXT_ARRAY_BASE AP 000001C@ L*1 TRANSLATION CORT RO FLAG { 
AP-0000001 I*4 TRANSLATION_END_BIT AP-00000014@ I*4 TRANSLATION_START_BIT : 
ARRAYS | 
Address Type Name Bytes Dimensions 
2-000000088 CHAR TEXT_ARRAY ee (*:8, 0:1) 
LABELS 
Address’ Label Address’ Label Address’ Label 
1-00000004 10° 1-00000010 20° shel 100 
FUNCTIONS AND SUBROUTINES REFERENCED 
Type Name Type Name Type Name ARI 
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Subroutine OUTPUT_MLINES (lun,string,sub_string,field_length) 
Author: Sharon Reynolds Creation date: 19-Mar-1981 


This module will take the passed character string and separate 
it at the delimiting character(s) and output it. If there are 
no Sot ret tng characters found, the string will be output 
on one Line. 
Because this routine is an interim solution for outpys ting 
multiple Lines of text, there are two restrictions; (1) the 
passed string will only be gepereted into six Lines and (2) the 
assed string can my be 192 characters in length (six Lines for 
character field). These restrictions may be changed by manipulating 
the size of ‘array’ and ‘c_string’. 


Modified by: 


Byte Lun 

Integer*4 field _length 
Integer*4 cnt 

Integer*4 num_lines 
Integer*4 sub_string_pos 
Integer*4 ret_status 
Integer*4 rstatus 
Integer*4 I 

integer*4 str$left 
integer*4 str$right 


Character*(*) string 
Character*80 array(0:5) 


Character! sub_string 
Character*192  c_string 


Initialize necessary variables 


Functional description: 
Cnt = 0 
| 
| 
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14 
Igege -1984 00:27:09 
=300- 1382 90:95:03 
C_string = string 
Locate the first occurence of the delimiter symbol in the string 


Sub_string_pos = INDEX (c_string,sub_string) 


If there was no delimiter symbol in the string then qutput it 
on one Line using the field length that was passed via the call 
If (sub _string_pos .eq. 0) then 

Call LINCHK (Lun,1) 

Write (Lun, 10) string 

Format (* *,140,A<field_length>) 

Return 

Endif 

There was a delimiter symbol found in the string; separate the 
string at the delimiter 

Ret_status = STRSLEFT (array(cnt),c_string,(sub_string_pos - 1)) 
Cnt = cnt + 1 

Rstatus = STRSRIGHT (array(cnt),c_string,(sub_string_pos + 1)) 
See if there is another delimiter symbol in the second portion 
of the string and make a copy of the string 

Sub_string_pos = INDEX (array(cnt),sub_string) 

C_String = array(cnt) 

Check to see if the string has been separated into the maximum 
number of Lines and if so, output the strings 

If (cnt .eq. 5) then 

Goto 25 

Endif 


Check to see if a deiimiter symbol was found in the second 
portion of the string and if so, go separate the string 
again 
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If (sub _string_pos .ne. 0) then 


The strings are ready to be output so do it. 


Num_lines = cnt 
C 0 
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Call LINCHK (Lun, (num_Lines)) 
Write (Lun, mf arra 


Write (Lun, 9) tt? 
A<field_length>) 
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| 
PROGRAM SECTIONS | 
Attributes | 


Type Name 
1*4 LIBSINDEX 


FUNCTIONS AND SUBROUTINES REFERENCED 
Type Name 
LINCHK 


Type Name 
I*4 STRSLEFT 


Type Name 
1*4 STRSRIGHT 


Name Bytes 
SCODE 414 PIC CON REL LCL SHR EXE RD NOWRT LONG 
1 SPDATA 44 PIC CON REL LCL SHR NOEXE RD NOWRT LONG 
2 SLOCAL 804 PIC CON REL LCL NOSHR NOEXE RD WRT LONG 
Total Space Allocated 1262 
ENTRY POINTS 
Address Type Name 
0-00000000 OUTPUT_MLINES 
VARIABLES 
Address Type Name Address Type Name 
$-00008 sng 1*4 CNT -Q00001EO CHAR C_STRING 
~000002B8a I*4 FIELD_LENGTH -0000 rr I*4 17 
AP @t*ei -t -0000 1*4 ot LINES 
2-000002AC I*4 RET_STATUS -00000 80 I*4 RSTATUS 
AP 8a CHAR STR AP-0000000C@ CHAR SUB_STRING 
2-000002A8 I*4 SUB_STRING_POS 
ARRAYS 
Address Type Name Bytes Dimensions 
2-00000000 CHAR ARRAY 480 (0:5) 
LABELS 
Address Label Address’ Label Address Label Address’ Label Address Label Address’ Label 
1-00000004 8 0-0000006E 20 O-O00000EE 25 1-00000010 27° 1-0000001C 30° sald 
ee 
| 
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COMMAND QUALIFIERS 


FORTRAN /LIS=LIS$:OUTPUT/OBJ=0BJ$:OUTPUT MSRCS$:OUTPUT 


/ CHE CK= (NOBOUNDS OEE ON ie NOUNDERF LOW) 
=(NO x NOU 


COMPILATION STATISTICS 


Run Time: ‘- seconds 
E\epsed Time: seconds 
Page Faults: 1 

Dynamic Memory: 174 pages 
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